Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-03/imb9102.zip/CMDPARSE.BAS

BASIC Source File | 1991-02-18 | 20KB | 609 lines

' *******************************************
' **                                       **
' **    "DOS Command Line Parse Engine"    **
' **        Version 0.99 - 12/20/90        **
' **                                       **
' *******************************************

' This is a group of procedures that form a "parse engine" for
' DOS. The "parse engine" breaks COMMAND$ down into individual
' switches and checks the switch against a given list of legal
' switches and "switch aliases". If the switch is legal up to
' this point, it is checked further for correct syntax (i.e.
' legal parameters, etc.)

' The general syntax that is accepted by the "parse engine" is:
'
'       PROGNAME [InputFileSpec [OutputFileSpec]] [Switches]
'
' NOTE: PROGNAME stands for the name of the program being
'       executed, which is NOT part of the data checked by
'       the "parse engine".

' $DYNAMIC

DEFINT A-Z

CONST FALSE = 0, TRUE = NOT FALSE
CONST ValidSymbol$ = "/-#"   ' Set equivalent switch symbols

TYPE NumericParameterType
  Minimum AS INTEGER
  Maximum AS INTEGER
  Default AS INTEGER
END TYPE

DECLARE FUNCTION BaseFilename$ (Filespec$)
DECLARE FUNCTION BTRIM$ (Argument$)
DECLARE FUNCTION Extension$ (Filespec$)
DECLARE FUNCTION FinishedFilespec$ (Filespec$, DefaultFilepec$)
DECLARE FUNCTION NumericSwitchValue (SwitchNameToCheck$)
DECLARE FUNCTION TextSwitchValue$ (SwitchNameToCheck$)

DECLARE SUB GetLegalSwitches ()
DECLARE SUB ParseFilespecs (DefaultInputName$,DefaultOutputName$)
DECLARE SUB ParseSwitches ()

DECLARE SUB RunParseEngine () ' Demonstrate the "parse engine"

ON ERROR GOTO Oops

OPTION BASE 1

'BEGINNING OF SECTION 1 OF 3 FOR QBX 7.X USERS
DIM SwitchName$(1), SwitchAlias$(1), SwitchType(1)
DIM NumericParameter(1) AS NumericParameterType
DIM SwitchValue(1), SwitchText$(1)
'END SECTION 1 OF 3 FOR QBX 7.X USERS

'BEGINNING OF SECTION 1 OF 3 FOR QB 4.X USERS
'NbrParms = 8
'DIM SwitchName$(NbrParms), SwitchAlias$(NbrParms),
'DIM SwitchType(NbrParms)
'DIM NumericParameter(NbrParms) AS NumericParameterType
'DIM SwitchValue(NbrParms), SwitchText$(NbrParms)
'END OF SECTION 1 OF 3 FOR QB 4.X USERS

RunParseEngine

END


LegalSwitchList:

  ' All the information regarding the switches (and their
  ' aliases) is kept here. The first item of each line is
  ' a legal switch name, followed by an alias name for that
  ' switch. The next data item is an integer value that
  ' classifies the type of data associated with the
  ' corresponding switch. This value governs exactly what
  ' subsequent data is expected to be read next. The format
  ' of each line of data is as follows:

  '   DATA  SWITCH,ALIAS,0                 NO PARAMETERS ALLOWED
  '   DATA  SWITCH,ALIAS,1,Min,Max,Default Opt # parm accepted
  '   DATA  SWITCH,ALIAS,2                 Opt Text parm accepted
  '   DATA  SWITCH,ALIAS,3,Min,Max,Default Opt Text OR # parm
  '   DATA  SWITCH,ALIAS,-1,Min,Max        # parm REQUIRED
  '   DATA  SWITCH,ALIAS,-2                Text parm REQUIRED
  '   DATA  SWITCH,ALIAS,-3,Min,Max        Text OR # parm RQD

  ' NOTE: A local error handler is used to trap an "Out of data"
  ' error, so the GetLegalSwitches procedure ends gracefully, and
  ' no "sentinel" data is required here.

  DATA B,BATCH,0
  DATA D,DECODE,-1,1,3
  DATA E,ENCODE,1,0,2,0
  DATA H,HELP,0
  DATA L,LOCK,0
  DATA S,SORT,2
  DATA X,ERR,0
  DATA ?,,0


Oops:

  ' This is an error handler designed to trap the custom error
  ' codes generated by the SUB ParseSwitches. The custom errors
  ' are:

  '   Error Code  Condition
  '   ==========  =========
  '   200         Switch is illegal (not part of LegalSwitchList)
  '   201         Missing required switch parameter
  '   202         Switch has a parameter but should not have one
  '   203         Numeric/Text mismatch
  '   204         Illegal parameter quantity
  '   205         Switch has been duplicated

  SELECT CASE ERR
    CASE 200
      PRINT "Unknown switch: "; BadSwitch$
    CASE 201
      PRINT "Missing parameter in switch: "; BadSwitch$
    CASE 202
      PRINT "Extraneous parameter in switch: "; BadSwitch$
    CASE 203
      PRINT "Parameter type mismatch in switch: "; BadSwitch$
    CASE 204
      PRINT "Illegal quantity in switch: "; BadSwitch$
    CASE 205
      PRINT "Duplicate switch: "; BadSwitch$
    CASE ELSE
      PRINT "BASIC run-time error #"; MID$(STR$(ERR), 2)
  END SELECT

'BEGINNING OF SECTION 2 OF 3 FOR QBX 7.X USERS
  END ERR ' All errors are trapped, so RESUME is not necessary
'END OF SECTION 2 OF 3 FOR QBX 7.X USERS

'BEGINNING OF SECTION 2 OF 3 FOR QB 4.X USERS
'  END
'END OF SECTION 2 OF 3 FOR QB 4.X USERS

FUNCTION BaseFilename$ (Filespec$) STATIC

  ' This FUNCTION returns a truncated Filespec$, with the
  ' extension cut off. If Filespec$ had a trailing period only
  ' with no extension, the trailing period is not removed. This
  ' will signal ParseFilespecs to not append a default file
  ' extension onto Filespec$, when requested.

  Position = INSTR(Filespec$, ".")
  SELECT CASE Position
    CASE 0, LEN(Filespec$)
      Build$ = Filespec$ ' leave "as is"...
    CASE 1
      Build$ = ""
    CASE ELSE
      Build$ = LEFT$(Build$, Position - 1)
  END SELECT

  BaseFilename$ = Build$

END FUNCTION

REM $STATIC
FUNCTION BTRIM$ (Argument$) STATIC

  BTRIM$ = RTRIM$(LTRIM$(Argument$)) ' BTRIM for "BOTH TRIM".

END FUNCTION

FUNCTION Extension$ (Filespec$) STATIC

  ' This FUNCTION returns only the FILE EXTENSION of a given
  ' FileSpec, if one exists in the FileSpec parameter. Extensions
  ' are parsed only where it is legal for them to be present.

  IF LEN(Filespec$) > 4 THEN
    Position = INSTR(LEN(Filespec$) - 4, Filespec$, ".")
  ELSE
    Position = INSTR(Filespec$, ".")
  END IF

  IF (Position > 0) AND (Position < LEN(Filespec$)) THEN
    Extension$ = MID$(Filespec$, Position)
  ELSE
    Extension$ = ""
  END IF

END FUNCTION

FUNCTION FinishedFilespec$ (Filespec$, DefaultFilespec$)

  ' This FUNCTION is used internally by ParseFilespecs to supply
  ' any default filespec information not already supplied by
  ' the user.

  IF LEN(BaseFilename$(Filespec$)) THEN
    IF RIGHT$(Filespec$, 1) <> "." THEN
      IF LEN(Extension$(Filespec$)) = 0 THEN _
             Filespec$ = Filespec$ + Extension$(DefaultFilespec$)
    END IF
  ELSE
    IF LEN(BaseFilename$(DefaultFilespec$)) THEN
      Filespec$ = DefaultFilespec$
    END IF
  END IF

  FinishedFilespec$ = Filespec$

END FUNCTION

REM $DYNAMIC
SUB GetLegalSwitches STATIC

  ' All of the information regarding the switches (and their
  ' aliases) is read here, according to the data format
  ' established in the main module (LegalSwitchList).

  SHARED SwitchName$(), SwitchAlias$(), SwitchType(), _
         NumericParameter() AS NumericParameterType, _
         SwitchValue(), SwitchText$()


  RESTORE LegalSwitchList ' For use when other data is added.
                          '   LegalSwitchList data MUST BE PLACED
                          '   LAST, AFTER ALL OTHER DATA.

'BEGINNING OF SECTION 3 OF 3 FOR QBX 7.X USERS

  ON LOCAL ERROR GOTO GLSerror

  DO
    Index = Index + 1

    REDIM PRESERVE SwitchName$(Index), SwitchAlias$(Index)
    REDIM PRESERVE SwitchType(Index)
    REDIM PRESERVE NumericParameter(Index) AS NumericParameterType

    READ SwitchName$(Index),SwitchAlias$(Index),SwitchType(Index)
    SELECT CASE SwitchType(Index)
      CASE 0, 2, -2                    ' Nothing more to read...
      CASE 1, 3
        READ NumericParameter(Index).Minimum,_
             NumericParameter(Index).Maximum,_
             NumericParameter(Index).Default
      CASE -1, -3
        READ NumericParameter(Index).Minimum,_
             NumericParameter(Index).Maximum
      CASE ELSE
        ERROR 2 ' Syntax error (illegal data)
    END SELECT
  LOOP WHILE LEN(SwitchName$(Index))

  IF Index > 1 THEN _
    REDIM PRESERVE SwitchName$(Index - 1), _
      SwitchAlias$(Index - 1),SwitchType(Index - 1), _
      NumericParameter(Index - 1) AS NumericParameterType, _
      SwitchValue(Index - 1), SwitchText$(Index - 1)
  EXIT SUB

GLSerror: ' Intercepts "Out of data" error only

  IF ERR = 4 THEN RESUME NEXT ELSE ERROR ERR

'END SECTION 3 OF 3 FOR QBX 7.X USERS

'BEGINNING OF SECTION 3 OF 3 FOR QB 4.X USERS

'  FOR Index = 1 TO UBOUND(SwitchName$)
'    READ SwitchName$(Index), SwitchAlias$(Index),_
'         SwitchType(Index)
'    SELECT CASE SwitchType(Index)
'      CASE 0, 2, -2              ' Nothing more to read...
'      CASE 1, 3
'        READ NumericParameter(Index).Minimum,_
'             NumericParameter(Index).Maximum,_
'             NumericParameter(Index).Default
'      CASE -1, -3
'        READ NumericParameter(Index).Minimum,_
'             NumericParameter(Index).Maximum
'      CASE ELSE
'        ERROR 2 ' Syntax error (illegal data)
'    END SELECT
'  NEXT Index

'END OF SECTION 3 OF 3 FOR QB 4.X USERS

END SUB

FUNCTION NumericSwitchValue (SwitchNameToCheck$)

  ' This FUNCTION looks up the value of a given switch, by the
  ' name of the switch. Of course, if no value was entered after
  ' the switch name a zero will be returned. Other possible
  ' values include &H8000 (if the switch was not found in
  ' COMMAND$) and &H8001 (meaning that this is a "text switch").
  ' Switch aliases are not allowed to be used to look up a value,
  ' in order to keep the code compact. Use of a "switch symbol"
  ' (/, etc.) before the name may be used, but is not required.

  SHARED SwitchName$(), SwitchValue()

  ' The next instruction makes the FUNCTION somewhat "forgiving"

  SwitchNameToCheck$ = BTRIM$(UCASE$(SwitchNameToCheck$))

  IF INSTR(ValidSymbol$, LEFT$(SwitchNameToCheck$, 1)) THEN _
    SwitchNameToCheck$ = LTRIM$(MID$(SwitchNameToCheck$, 2))

  Index = 0
  DO
   Index = Index + 1
  LOOP UNTIL (Index = UBOUND(SwitchName$)) OR _
    (SwitchName$(Index) = SwitchNameToCheck$)

  IF SwitchName$(Index) = SwitchNameToCheck$ THEN
    NumericSwitchValue = SwitchValue(Index)
  ELSE
    NumericSwitchValue = &H8000
  END IF

END FUNCTION


SUB ParseFilespecs (DefaultInputName$, DefaultOutputName$) STATIC

  ' This SUB builds input and output FileSpecs for use by other
  ' procedures, using the supplied filenames if none were entered
  ' from the DOS command line. Lone extensions may also be used
  ' for DefaultInputName$ and DefaultOutputName$; this is used
  ' to force a filename to be required, yet allowing a default
  ' extension to be used.

  SHARED InputFilespec$, OutputFilespec$

  DefaultInputName$ = UCASE$(BTRIM$(DefaultInputName$))
  DefaultOutputName$ = UCASE$(BTRIM$(DefaultOutputName$))

  IF INSTR(ValidSymbol$, LEFT$(COMMAND$, 1)) THEN
    FileSpecParameters$ = ""
  ELSE
    FOR Index = 1 TO LEN(ValidSymbol$)
      SymbolPosition = INSTR(COMMAND$,MID$(ValidSymbol$,Index,1))
      IF SymbolPosition THEN _
        IF (SymbolPosition < FirstSwitchPosition) OR _
           (FirstSwitchPosition = 0) THEN _
            FirstSwitchPosition = SymbolPosition
    NEXT
    IF FirstSwitchPosition THEN
      FileSpecParameters$ = LEFT$(COMMAND$,FirstSwitchPosition-1)
    ELSE
      FileSpecParameters$ = COMMAND$
    END IF
  END IF

  InBuild$ = FinishedFilespec$(BTRIM$(LEFT$(FileSpecParameters$,_
    INSTR(FileSpecParameters$ + " ", " "))), DefaultInputName$)
  OutBuild$ = FinishedFilespec$(BTRIM$(MID$(FileSpecParameters$,_
    LEN(InBuild$) + 1)), DefaultOutputName$)

  InputFilespec$ = InBuild$
  OutputFilespec$ = OutBuild$

END SUB

SUB ParseSwitches STATIC

  ' This SUB parses COMMAND$, checks for proper switch syntax,
  ' proper parameter types and values, and also ensures that a
  ' switch is not duplicated. Custom errors may be generated, as
  ' follows:

  '   Error Code      Condition
  '   ==========      =========
  '       200         Switch is illegal (not in LegalSwitchList)
  '       201         Missing required switch parameter
  '       202         Switch has a parameter but should not
  '       203         Numeric/Text mismatch
  '       204         Illegal parameter quantity
  '       205         Switch has been duplicated

  ' Every switch will return a numeric value in the SwitchValue
  ' array. Note that the value &H8000 is initially assigned to
  ' each element to indicate that the switch wasn't found in
  ' COMMAND$. This is used to during the parsing process to
  ' determine if a switch is duplicated. Later, the application
  ' can determine if the switch was ever found in COMMAND$.

  ' The value &H8001 is assigned to those switches that have
  ' valid text data that should be read in the SwitchText$ array.

  SHARED SwitchName$(), SwitchAlias$(), SwitchType(), _
         NumericParameter() AS NumericParameterType, _
         SwitchValue(), SwitchText$()
  SHARED BadSwitch$ ' Used to refer to current switch name in
                    '   error trapping, should that be necessary

  FOR Index = 1 TO UBOUND(SwitchName$)
      SwitchValue(Index) = &H8000
  NEXT

  IF LEN(COMMAND$) AND _
    NOT (INSTR(ValidSymbol$, RIGHT$(COMMAND$, 1)) > 0) THEN

    FOR Index = 1 TO LEN(ValidSymbol$)
      SymbolPosition = INSTR(COMMAND$,MID$(ValidSymbol$,Index,1))
      IF SymbolPosition THEN _
         IF (SymbolPosition < Position) OR _
            (Position = 0) THEN Position = SymbolPosition
    NEXT

    DO
      NextPosition = 0 ' FOR...NEXT loop sets NextPosition to _
                       '   lowest SymbolPosition past current _
                       '   value of Position

      FOR Index = 1 TO LEN(ValidSymbol$)
        SymbolPosition = INSTR(Position + 1, COMMAND$, _
                          MID$(ValidSymbol$, Index, 1))
        IF SymbolPosition THEN _
          IF (SymbolPosition < NextPosition) OR _
             (NextPosition = 0) THEN NextPosition=SymbolPosition
      NEXT

      IF NextPosition THEN
        ParameterCheck$ = MID$(COMMAND$, Position + 1, _
                          NextPosition - (Position + 1))
      ELSE
        ParameterCheck$ = MID$(COMMAND$, Position + 1)
        NextPosition = LEN(COMMAND$)
      END IF

      SwitchFound = FALSE
      Index = 0
      DO
        Index = Index + 1
        IF LEN(SwitchAlias$(Index)) THEN _
          SwitchFound = (INSTR(ParameterCheck$, _
          SwitchAlias$(Index)) = 1)
      LOOP UNTIL (SwitchFound) OR Index = UBOUND(SwitchName$)

      BadSwitch$ = LEFT$(ValidSymbol$, 1) + SwitchName$(Index)

      IF SwitchFound THEN
        IF SwitchValue(Index) = &H8000 THEN
          Position = Position + LEN(SwitchAlias$(Index)) + 1
          SwitchValue(Index) = 0
        ELSE
          ERROR 205 ' Duplicate switch
        END IF
      ELSE
        Index = 0
        DO
          Index = Index + 1
          SwitchFound = (INSTR(ParameterCheck$, _
                         SwitchName$(Index)) = 1)
        LOOP UNTIL (SwitchFound) OR Index = UBOUND(SwitchName$)

        BadSwitch$ = LEFT$(ValidSymbol$, 1) + SwitchName$(Index)

        IF SwitchFound THEN
          IF SwitchValue(Index) = &H8000 THEN
            Position = Position + LEN(SwitchName$(Index)) + 1
            SwitchValue(Index) = 0
          ELSE
            ERROR 205 ' Duplicate switch
          END IF
        ELSE
          BadSwitch$ = LEFT$(ValidSymbol$, 1) + ParameterCheck$
          IF INSTR(BadSwitch$, ":") > 2 THEN _
            BadSwitch$ = _
              LEFT$(BadSwitch$, INSTR(BadSwitch$, ":") - 1)
          ERROR 200 ' Illegal switch
        END IF
      END IF

      IF SwitchFound THEN
        IF (MID$(COMMAND$, Position, 1) = ":") AND _
           (Position < LEN(COMMAND$)) THEN Position = Position+1
        IF NextPosition < LEN(COMMAND$) THEN
          ParameterCheck$ = BTRIM$(MID$(COMMAND$, Position, _
                                        NextPosition - Position))
        ELSE
          ParameterCheck$ = LTRIM$(MID$(COMMAND$, Position))
        END IF

        IF LEN(ParameterCheck$) THEN
          IF SwitchType(Index) = 0 THEN
            ERROR 202 ' Parameter not allowed!
          ELSE
            IF INSTR("0123456789",LEFT$(ParameterCheck$, 1)) THEN
                IF ABS(SwitchType(Index)) = 2 THEN
                    ERROR 203 ' Switch parameter type mismatch
                ELSE
                    SwitchValue(Index) = VAL(ParameterCheck$)
                    IF (SwitchValue(Index) < _
                        NumericParameter(Index).Minimum) OR _
                        (SwitchValue(Index) > _
                        NumericParameter(Index).Maximum) THEN _
                          ERROR 204  ' Illegal quantity
                END IF
            ELSE
                IF ABS(SwitchType(Index)) = 1 THEN
                    ERROR 203 ' Switch parameter type mismatch
                ELSE
                    SwitchText$(Index) = ParameterCheck$
     ' Indicates that there is valid text in SwitchText$(Index)..
                    SwitchValue(Index) = &H8001
                END IF
            END IF
          END IF
        ELSE
          IF SwitchType(Index) < 0 THEN
            ERROR 201                       ' Parameter required!
          ELSEIF SwitchType(Index) = 2 THEN
' Indicates that the value of SwitchText$(Index) is the null text
            SwitchValue(Index) = &H8001
          ELSE
            SwitchValue(Index) = NumericParameter(Index).Default
          END IF
        END IF
      END IF

      Position = NextPosition
    LOOP UNTIL Position = LEN(COMMAND$)
  END IF

END SUB

SUB RunParseEngine STATIC

  ' This SUB demonstrates how the components of the "Parse
  ' Engine" work together.

  SHARED SwitchName$(), SwitchAlias$(), SwitchType()
  SHARED NumericParameter() AS NumericParameterType,SwitchText$()
  SHARED SwitchTextData$ ' For use only if SwitchVal
                         '   returns a value of &H8006
  SHARED InputFilespec$, OutputFilespec$

  Q$ = CHR$(34)

  PRINT
  PRINT "CMDPARSE - DOS Command Line "; q$; "Parse Engine"; q$
  PRINT "Copyright (c)1991 Barry L. Camp - All Rights Reserved"
  PRINT
  PRINT "COMMAND$   : "; q$; COMMAND$; q$
  GetLegalSwitches
  ParseFilespecs "TESTFILE.IN", "TESTFILE.OUT"
  PRINT "Input File : "; q$; InputFilespec$; q$
  PRINT "Output File: "; q$; OutputFilespec$; q$
  PRINT
  ParseSwitches
  IF LEN(SwitchName$(1)) THEN
    FOR Index = 1 TO UBOUND(SwitchName$)
      PRINT "Value of "; q$; LEFT$(ValidSymbol$, 1); _
             SwitchName$(Index); q$; " is ";
      Value = NumericSwitchValue(SwitchName$(Index)) ' BYVAL
      SELECT CASE Value
        CASE &H8000
          PRINT "undefined (switch not found in COMMAND$)"
        CASE &H8001
          PRINT q$; SwitchText$(Index); q$
        CASE ELSE
          PRINT MID$(STR$(Value), 2)
      END SELECT
    NEXT
  ELSE
    PRINT "No legal switches were defined."
  END IF

END SUB

FUNCTION TextSwitchValue$ (SwitchNameToCheck$) STATIC

  ' This FUNCTION looks up the "text value" of a given switch, by
  ' the name of the switch. "Text value" means the text of the
  ' non-numeric parameter following the switch name (and the
  ' optional colon). Of course, if no text was entered after the
  ' switch name (or this is not a "text switch"), then a null
  ' string is returned. Switch aliases are not allowed to be used
  ' to look up a text value, in order to keep the code compact.
  ' Use of a "switch symbol" (/, etc.) before the name may be
  ' used, but is not required.

  SHARED SwitchName$(), SwitchText$()

  ' this makes the FUNCTION somewhat "forgiving"...
  SwitchNameToCheck$ = BTRIM$(UCASE$(SwitchNameToCheck$))
  IF INSTR(ValidSymbol$, LEFT$(SwitchNameToCheck$, 1)) THEN _
    SwitchNameToCheck$ = LTRIM$(MID$(SwitchNameToCheck$, 2))

  Index = 0
  DO
     Index = Index + 1
  LOOP UNTIL (Index = UBOUND(SwitchName$)) OR _
             (SwitchName$(Index) = SwitchNameToCheck$)

  IF SwitchName$(Index) = SwitchNameToCheck$ THEN
      TextSwitchValue$ = SwitchText$(Index)
  ELSE
      TextSwitchValue$ = ""
  END IF

END FUNCTION